home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / System source / Frontend < prev    next >
Encoding:
Text File  |  1995-11-19  |  7.4 KB  |  256 lines  |  [TEXT/YERK]
  1. \ frontEnd - menus and handlers for Yerk menu bar
  2. \ 12/20/84  cbd Version 1
  3. \  7/05/86  cdn Added HFS references
  4. \  7/09/86  cdn Expanded Util & Yerk menus; added .ok
  5. \  8/10/86  cdn Added savefW, restfW, enfW, disfW
  6. \  8/31/88    rfl made parmstr object of string; added show: fwind in yerk
  7. \ 10/04/88    rfl    brought back old npath
  8. \ 10/03/90    rfl    added 0 ?event drop to get window out in front in mf
  9. \  3/23/91    rfl    don't check for hfs ..just assume
  10. \  5/10/91    rfl    editor name now at string resource id 99
  11. \  6/09/91    rfl modified editor name...in rsrc, make sure it starts with two zeros
  12. \ 11/17/91    rfl    added 7.0.1 fix readFP before saving image
  13. \  4/24/92    rfl    added closeAll for development
  14. \  5/14/92    rfl    removed savefw
  15. \ 10/14/92    rfl    sysedits now supports key: window; cut,copy,paste for the front window
  16. \  1/02/93    rfl    menus now in resources. Old menu module still available, though.
  17. \  5/03/93    rfl    added new tool1 for testing
  18. \  5/20/93    rfl    added saver to save currently named document in same folder as original
  19. \  5/07/95    rfl change enf to enable the entire menubar
  20. \  7/16/95    rfl    removed draw: fwind from stdload; replaced with draw: actw
  21. \                Also changed stdPut: accordingly
  22. \ 10/14/95    rfl    removed maxdict since it isn't used..if needed, just do msize !
  23. \ 11/9/95    rfl    removed 'frontend' since +docs were set for mforget
  24. \ 11/19/95    rfl    removed INLINE and moved to file source
  25.  
  26. Decimal
  27.  
  28.  
  29. from tool1 import{ endtool asmcall1 call1 fcall1 global1 } 3 immediates
  30.  
  31. Create (flush) popD0 " FlushEvents" asmCall next,
  32. Create (post) popD0 popA0 " PostEvent" asmCall next,
  33. : .ok 8 (flush) 3 13 (post) ;
  34.  
  35. \ ============== Menu handlers =================
  36.  
  37. \ define the menus for the Yerk menu bar
  38.  5 menu FileMen
  39.  9 menu EditMen
  40.  6 menu UtilMen
  41. 10 menu YerkMen
  42.  6 hmenu ListMen
  43.  
  44. BasicStr imageName
  45. string parmStr
  46.  
  47. \ get file from stdFile and load it as source
  48. : stdLoad
  49.     new: loadFile
  50.     txType 1 stdGet: topFile
  51.     draw: actw
  52.     IF interpret: topFile .ok THEN
  53.     remove: loadFile ;
  54.  
  55. : readFP " fpInit" sFind
  56.     IF 2drop 5 'type CODE (getres) dup >ptr 'f> rot 0 swap call SizeResource cmove 
  57.     THEN ;
  58.  
  59. \ Resave current dictionary
  60. : doSave .cur readFP
  61.     get: imageName  name: fFcb (save)
  62.     curs -curs cr ." Saved: " print: imageName cr
  63.     -> curs .ok ;
  64.  
  65. \ save via stdFile
  66. : stdSave .cur
  67.     " Save Dictionary As:"  get: imageName str255 -base count
  68.     stdPut: fFcb
  69.     draw: actw
  70.     IF  readFP (save)
  71.         getVref: ffcb finfo 4+ w!    \ save vref in finfo area
  72.         getName: fFcb put: imageName 
  73.         alive: fwind IF get: imageName title: fWind THEN
  74.         curs -curs cr ." Saved: " print: imageName cr
  75.         -> curs .ok
  76.     THEN ;
  77.  
  78. \ Save current document in same directory as initial document, or the
  79. \   last stdSave'd document...take name from
  80. \   the fwind (which should be the last stdSave'd document)
  81. : Saver readFP
  82.         get: imageName name: fFcb finfo 4+ w@ setVref: fFcb (save)
  83.      ." Saved: " print: imageName cr ;
  84.  
  85. \ Select and print a text file
  86. : Print
  87.     new: loadFile
  88.     txType 1 stdGet: topFile
  89.     draw: fWind
  90.     IF qPrint THEN
  91.     remove: loadfile ;
  92.  
  93. \ ============== Edit Menu =================
  94.  
  95. \ scrap support
  96. Var  theOffset
  97.  
  98. : getScrap
  99.     0 handle: parmStr  txType abs: theOffset
  100.     call GetScrap ;
  101.  
  102. \ get next char from the scrap
  103. : scrapKey
  104.     next: parmStr 0=
  105.     IF rekey 13 THEN ;    \ simulate a terminal cr
  106.  
  107. \ interpret from the scrap
  108. : xDoit
  109.     getScrap 0>
  110.     IF 0 moveTo: parmStr 'c scrapKey -> keyVec
  111.     THEN  sp! mp! quit ;
  112.  
  113. : frontWind 0 call frontwindow -base ;
  114.  
  115. \ editing commands pass thru to desk accessories
  116. : sysEd   >R word0 R> makeInt call SystemEdit word0 ;
  117. : sysCut    2 sysEd not IF  cut: [ frontWind ] THEN ;
  118. : sysCopy   3 sysEd not IF copy: [ frontWind ] THEN ;
  119. \ pastes only into the fwind...
  120. : sysPaste  { \ theWInd -- } 4 sysEd not
  121.         IF frontWind -> theWind
  122.             theWind fwind =
  123.             IF xDoit
  124.             ELSE paste: theWind
  125.             THEN
  126.         THEN ;
  127. : sysClear  5 sysEd not IF clear: [ frontWind ] THEN ;
  128. : SelectAll selectAll: [ frontWind ] ;
  129.  
  130. \ this string holds the name of the McSink desk accessory
  131. : edName 99 getString ;    \ leading null char
  132. : doEdit   savePort word0 edName str255 call OpenDeskAcc word0 drop restPort ;
  133.  
  134. \ ============== Util Menu =================
  135.  
  136. \ call words from utility module
  137. : doWords .cur
  138.     curs -curs words -> curs .ok ;
  139.  
  140. \ start the object list utility via its input dialog
  141. : doOlist
  142.     " List objects of class:" doInDlg
  143.     IF over +base over >uc objList .ok THEN ;
  144.  
  145. \ start the object list with a word in the stream
  146. : do' @word count objList ;
  147.  
  148. \ run the class lister
  149. : doClist .classes .ok ;
  150.  
  151. \ start the decompile utility via its input dialog
  152. : doDe
  153.     " Enter word to decompile:" doDeDlg
  154.     IF  tib 128 erase  0 -> in    \ simulate terminal input from dialog text
  155.         tib swap cMove de' .ok
  156.     THEN ;
  157.  
  158. \ start the grep utility via its input dialog
  159. : doGrep
  160.     " Enter string for search:" doGrDlg
  161.     IF (grep) .ok THEN ;
  162.  
  163. \ ============== Yerk Menu =================
  164.  
  165. \ ( item# b -- ) check item if boolean is true
  166. : chkYerk
  167.     IF   check: yerkMen
  168.     ELSE unCheck: yerkMen
  169.     THEN ;
  170.  
  171. 0 value prEcho
  172. 0 value LEcho
  173.  
  174. : ?yerkFlgs  3 LEcho chkYerk 2 dEcho chkYerk  1 prEcho chkYerk ;
  175.  
  176. \ toggle echo to printer
  177. : pEcho
  178.     precho 1 xor -> prEcho prEcho
  179.     IF +print
  180.     ELSE -print dispose> printMod
  181.     THEN ?yerkFlgs ;
  182.  
  183. \ toggle echo during loads
  184. : ldEcho  decho 1 xor -> decho  ?yerkFlgs ;
  185.  
  186. : logging LEcho 1 xor -> LEcho LEcho
  187.     IF +file
  188.     ELSE -file dispose> logMod
  189.     THEN ?yerkflgs ;
  190.  
  191. \ print path list
  192. : .path path IF cr print: path ELSE ." No paths defined." THEN .ok ;
  193.  
  194. \ ( -- maxBlk )  Call register-based toolbox routine
  195. create maxmem
  196.     " MaxMem" asmCall
  197.     pushD0
  198.     next,
  199.  
  200. \ print room remaining in heap, dictionary
  201. : .room cr maxmem    \ compression first
  202.     ." Room in Dictionary:    " room 6 .r cr
  203.     ." Total Heap (no purge): " free 6 .r cr
  204.     ." Largest Block (purge): "      6 .r cr .ok ;
  205.  
  206. : doMlist .mods .ok ;
  207.  
  208. \ note that doSave has been replaced with saver
  209.  2 'cfas about null                                                            1 put: appleMen
  210.  5 'cfas stdLoad Saver stdSave Print bye                                    2 put: fileMen
  211.  9 'cfas null null sysCut sysCopy sysPaste sysClear selectAll null doEdit    3 put: editMen
  212.  6 'cfas null exam doDe doGrep null install                                    4 put: utilMen
  213. 10 'cfas pEcho ldEcho logging null .path .room doMlist purge null null        5 put: yerkMen
  214.  6 'cfas doWords doOlist hier doClist .vects .vals                              48 put: ListMen
  215.  
  216. : nmenu applemen fileMen editMen utilMen yerkMen listmen 6 init: menubar ;
  217.  
  218. \ ============== Non-Menu related words =================
  219.  
  220. \ disable/enable actions for fWind
  221. : disfW
  222.     1 disable: FileMen 2 disable: FileMen 3 disable: FileMen
  223.     0 disable: UtilMen 0 disable: YerkMen ;
  224. :  enfW
  225.     1  enable: FileMen 2  enable: FileMen 3  enable: FileMen
  226.     0  enable: UtilMen 0  enable: YerkMen ;
  227.  
  228. \ close all windows except for the fwind
  229. : closeAll { \ theWindow -- } 0 call frontWindow
  230.     BEGIN -base -> theWindow
  231.           theWindow $ 90 + @                \ get next window in list
  232.           theWindow fwind <>                \ don't close fwind
  233.           IF close: theWindow THEN dup 0=    \ continue until no more windows
  234.     UNTIL drop set: fwind ;
  235.  
  236. : nPath " ::Yerk folder:nPath.txt" getPtxt ;
  237.  
  238. \ system startup word
  239. : yerk
  240.     sysInit    \ Initialize nucleus objects - fFcb, fEvent, fpRect, fWind
  241.     " fpInit" sFind IF drop cfa execute THEN    \ Initialize FP system
  242.     0 ?event drop abs: fWind call BeginUpdate
  243.     getVrect: fWind 14 + put: tempRect update: tempRect
  244.     abs: fWind call EndUpdate
  245.     initNewWindow: fwind show: fwind
  246.     <[ 2 ]> 'cfas enfW disfW setAct: fWind    \ fWind activate activities
  247.     OpenNR
  248.     new: imageName  new: parmStr
  249.     nPath
  250.     nMenu                                     \ get Yerk menu bar
  251.     initProcs                                \ loads all proc words with a5,a3
  252.     myDoc 2dup put: imageName title: fWind    \ fWind title bar
  253.     ?yerkFlgs release ;
  254.  
  255. 'c yerk -> objInit
  256.